home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 174
/
174.d81
/
sundial maker
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
3KB
|
116 lines
5 poke55,.:poke56,56:clr
10 dv=peek(186):ifdv<8thendv=8
15 poke53280,0:poke53281,0:print"[147]"
16 poke53371,0
30 ad=49152
35 sysad:sysad+12
38 bx$="[158]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_"
40 sysad+9,15:poke53272,31
42 print"[147][158]^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^"
43 printbx$;""tab(38)bx$
44 print"[158]^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^"
45 print"":printtab(5)"[158] [214][197][210][212][201][195][193][204] [211][213][206][196][201][193][204] [195][193][204][195][213][204][193][212][207][210] "
50 print:printtab(7)"[153][217]our [204]atitude:";:l9%=6:gosub500:b=q9
52 print:printtab(7)"[153][217]our [204]ongitude:";:l9%=6:gosub500:l=q9
55 ifb<0 thenprint"[145][145]":goto50
60 print:printtab(7)"[153][212]ime-zone [205]eridian:";:l9%=3:gosub500:l0=q9
65 print:printtab(7)"[153][193]zimuth [196]ial [198]aces:";:l9%=6:gosub500:f=q9
70 iff<=90orf>=270thenprint"[145][145]":goto65
75 p1=3.14159265:r1=p1/180
80 b1=b*r1:s=0
85 print:printtab(7)"[153][211]un [197][153]ast or [215][153]est":ct=0
86 gets$:ifs$<>"e"ands$<>"w"then86
88 sysad+9,16
90 ifs$="e"thens=-1
95 ifs$="w"thens=1
105 print:printtab(7)"[153][196]ial [200]eight:";:l9%=3:gosub500:h5=q9
110 print:printtab(7)"[153][215]idth of [212]his [208]art:";:l9%=3:gosub500:w5=q9
115 print:printtab(7)"[153][211]tep [211]ize in [205]inutes:";:l9%=2:gosub500:g=q9
116 print:printtab(8)"[159][201]s this correct? [217]/[206]":poke198,0
117 gethc$:ifhc$<>"y"andhc$<>"n"then117
118 ifhc$="n"then40
120 f1=p1/2+s*r1*(180-f):print
125 r5=w5/h5:z5=s*r1*(l0-l)
130 print"[147][153][204]at:";b"[153] [204]ong:";l;
135 print"[153] [205]erid:";l0
140 print"[153] [196]ial [198]aces [193]zimuth";f
145 gosub360
150 print"[153][211]un";s;" ";w5;
155 print"[153][215]ide by";h5;"[153][200]igh[158]"
160 h=12-s:g=s*g/60
165 :
170 ifct=18thengosub600
172 rem calculate loop
175 q=z5+s*p1*(h-12)/12
180 ifq<0then230
185 ifh<4orh>20then235
190 ifq<>0then200
195 k=0:goto220
200 k0=sin(f1)*tan(p1/2-q)
205 k1=cos(f1)*sin(b1)+k0
210 ifk1=0thenk1=1e-10
215 k=cos(b1)/k1
220 gosub255
225 ifk>=0thengosub280
230 h=h+g:goto170
235 gosub3000
245 s=0:goto85
250 :
255 rem decide x or y
260 d=s*k*h5:d$=" x="
265 ifk<r5then275
270 d=-w5/k:d$=" *y="
275 return
280 ct=ct+1:rem print a line
285 h0=h+.002
290 h1=int(h0):m1=int(60*(h0-h1))
295 m1$=str$(100+m1)
300 m1$="[158]:"+right$(m1$,2)
305 p$=" pm "
310 ifh1<12thenp$=" am "
315 ifh1<>12then325
320 ifm1=0thenp$=" noon "
325 ifh1>12thenh1=h1-12
330 h1$=str$(h1)
335 ifh1<10thenh1$=" "+h1$
340 d=int(d*1000+.5)/1000
345 printh1$;m1$;p$;
350 printtab(15);d$;d
355 return
360 rem compute end of style
365 p5=tan(p1/2-b1)*h5
370 z=sin(f1)*p5
375 z=int(z*1000+.5)/1000
380 x=s*tan(p1/2-f1)*z
385 x=int(x*1000+.5)/1000
390 y=-h5
395 print"[159][211]tyle end [195]oordinates"
400 print"[159]x=";x"[159], y=";y;"[159], z=";z"[158]"
405 return
500 q9$="":poke198,.
505 geta$
510 poke646,rnd(1)*15+1:print"*[157]";:ifa$=""then505
515 ifa$=chr$(13)thenprint" ":q9=val(q9$):return
520 if(a$=chr$(20)andlen(q9$))thenq9$=left$(q9$,len(q9$)-1):goto550
525 iflen(q9$)>=l9%thensysad+9,1:goto505
530 if(a$>="0"anda$<="9")ora$="."ora$="-"ora$="+"then540
535 goto505
540 q9$=q9$+a$
545 print""a$;:sysad+9,16:goto505
550 print" [157][157] [157]";:goto505
600 poke214,22:print:printtab(6)"[159][193]ny key to continue":poke198,0
610 geta$:ifa$=""then610
615 print"[147]":ct=0:gosub395
620 return
3000 print:printtab(3)"[150](1[150]) [207]ther side (2[150]) [211]tart [207]ver
3010 [153][163]8)"def(3def) (NULL)niverse menu
3020 poke198,0
3030 geta$:ifa$<"1"ora$>"3"then3030
3040 ifa$="1"thenprint"[147]":return
3045 ifa$="2"then38
3050 sysad+15
3060 print"[147][144]load"chr$(34)"b.universe iii"chr$(34)","dv
3070 print"run28"
3080 poke631,13:poke632,13:poke198,2:end
10000 d=peek(186):n$="0:sundial maker":open15,d,15,"s"+n$:close15:saven$,d:end